home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / clocks / attall / riseset.bas < prev    next >
Encoding:
BASIC Source File  |  1995-04-12  |  8.3 KB  |  347 lines
  1. Global TZ$()
  2. Global TZs%
  3.  
  4. Global gLongitude As String
  5. Global gLatitude As String
  6. Global gLocation As String
  7. Global gTimezone As String
  8. Global gDSTAuto As String
  9. Global gDST As String
  10. Global DSTStart, DSTStop
  11.  
  12.  
  13. 'You think the sun rise, set for you
  14. 'but the same sun rise and set and shine for other folks too
  15.  
  16.  
  17. ' 70    Print Tab(27); " An Astronomy Program"
  18. ' 80    Print
  19. ' 90    Print Tab(20); " adapted by Chris Spratt - June, 1985"
  20. '100    Print Tab(18); " and modified by David Birley - May, 1988"
  21. '110    Print
  22. '120    Print Tab(21); " from a program by William C. Bell"
  23. '130    Print Tab(17); "Published in Astronomy Magazine - April, 1984"
  24.  
  25. 'Thanks, all!!!
  26.  
  27. Sub CalcDSTStartStop (tNow)
  28. Dim I%
  29. For I% = 1 To 7
  30.    If Weekday(DateSerial(Year(tNow), 4, I%)) = 1 Then
  31.       DSTStart = DateSerial(Year(tNow), 4, I%)
  32.       Exit For
  33.    End If
  34. Next I%
  35.  
  36. For I% = 31 To 24 Step -1
  37.    If Weekday(DateSerial(Year(tNow), 10, I%)) = 1 Then
  38.       DSTStop = DateSerial(Year(tNow), 10, I%)
  39.       Exit For
  40.    End If
  41. Next I%
  42.  
  43. End Sub
  44.  
  45. Sub CalcSunRiseSet (tLONJ$, tLAT$, Zone#, DST%, ltNow, SunRise$, SunSet$)
  46. Dim A#, B#, C#, D#, E#, F#, G#, H#, LAT#, LONJ#
  47. Dim P#, Q#, R#
  48.  
  49. Dim Hrs%, Mns%
  50. Dim TStr$
  51. Dim PPos%
  52.  
  53. Zone# = SexagesimalToDecimal#(Zone#)
  54.  
  55. Zone# = -(Zone# - DST%)
  56.  
  57. 970    Let A = 1.5708
  58. 980    Let B = 3.14159
  59. 990    Let C = 4.71239
  60. 1000    Let D = 6.28319
  61. 1010    Let LAT = Val(tLAT$)
  62. 1020    Let LONJ = Val(tLONJ$)
  63.  
  64. 1040    Let tYEAR$ = Right$(Date$, 4)
  65. 1050    Let tMONTH$ = Left$(Date$, 2)
  66. 1060    Let tDAY$ = Mid$(Date$, 4, 2)
  67.  
  68. LAT# = SexagesimalToDecimal#(LAT#)
  69.  
  70. 1150    Let E = LAT * .0174533
  71.  
  72. LONJ# = SexagesimalToDecimal#(LONJ#)
  73.  
  74. 1210    Let F# = LONJ# * .0174533
  75.  
  76. 1270    Let G# = (Zone#) * .261799
  77.  
  78. 1310    H# = Year(ltNow)
  79.  
  80. 1350    I = Month(ltNow)
  81.  
  82. 1380    J = Day(ltNow)
  83.  
  84. 1410  Rem - DAY OF YEAR
  85. H# = Val(Format$(ltNow, "y"))
  86.  
  87. 1560    Let I = 0
  88. 1570    Let J = A
  89. 1580    GoSub 2180
  90.  
  91. 1590  Rem
  92. 1600    Let R = -.309017
  93. 1610    GoSub 2710
  94. 1620    'Debug.Print "A dawn "; V
  95.  
  96. 1630  Rem
  97. 1640    Let R = -.207912
  98. 1650    GoSub 2710
  99. 1660    'Debug.Print "N dawn "; V
  100.  
  101. 1670  Rem
  102. 1680    Let R = -.104528
  103. 1690    GoSub 2710
  104. 1700    'Debug.Print "C dawn "; V
  105.  
  106. 1710  Rem
  107. 1720    Let R = -.0145439
  108. 1730    GoSub 2710
  109. 'TStr$ = Format$(V, "0.00")
  110. Hrs% = Int(V)
  111. Mns% = 100 * (V - Hrs%)
  112. SunRise$ = LCase$(Format$(TimeSerial(Hrs%, Mns%, 0), "h:mma/p"))
  113. 'If Left$(SunRise$, 1) = "0" Then SunRise$ = Mid$(SunRise$, 2, 255)
  114. 1740    'Debug.Print "Sunris "; V, SUnRis$
  115. 1750  Rem
  116.  
  117. 1760  Rem - SETTING PHENOMENA
  118. 1770  Rem
  119. 1780    Let I = 1
  120. 1790    Let J = C
  121. 1800    GoSub 2180
  122.  
  123. 1810  Rem
  124. 1820    Let R = -.0145439
  125. 1830    GoSub 2710
  126. Hrs% = Int(V)
  127. Mns% = 100 * (V - Hrs%)
  128. SunSet$ = LCase$(Format$(TimeSerial(Hrs%, Mns%, 0), "h:mma/p"))
  129. 'If Left$(SunSet$, 1) = "0" Then SunSet$ = Mid$(SunSet$, 2, 255)
  130. 'SunSet$ = Format$(TimeValue(Format$(V, "0.00")), "h:mma/p")
  131. 1840    'Debug.Print "Sunset "; V
  132.  
  133. 1850  Rem
  134. 1860    Let R = -.104528
  135. 1870    GoSub 2710
  136. 1880    'Debug.Print "C dusk "; V
  137.  
  138. 1890  Rem
  139. 1900    Let R = -.207912
  140. 1910    GoSub 2710
  141. 1920    'Debug.Print "N dusk "; V
  142.  
  143. 1930  Rem
  144. 1940    Let R = -.309017
  145. 1950    GoSub 2710
  146. 1960    'Debug.Print "A dusk "; V
  147. 1970  Rem
  148. Exit Sub
  149.  
  150. 2150  Rem
  151. 2160  Rem - APPROXIMATE TIME
  152. 2170  Rem
  153. 2180    Let K = H + ((J + F) / D)
  154. 2190  Rem
  155. 2200  Rem - SOLAR MEAN ANOMALY
  156. 2210  Rem
  157. 2220    Let L = K * .017202
  158. 2230    Let L = L - .0574039
  159. 2240  Rem
  160. 2250  Rem - SOLAR TRUE LONGITUDE
  161. 2260  Rem
  162. 2270    Let Z = Sin(L)
  163. 2280    Let M = L + .0334405 * Z
  164. 2290    Let Z = Sin(2 * L)
  165. 2300    Let M = M + .000349066 * Z
  166. 2310    Let M = M + 4.93289
  167. 2320  Rem
  168. 2330  Rem - QUADRANT DETERMINATION
  169. 2340  Rem
  170. 2350    Let Z = M
  171. 2360    GoSub 3200
  172. 2370    Let M = Z
  173. 2380    Let X = M / A
  174. 2390    Let Y = Int(X)
  175. 2400    Let Z = X - Y
  176. 2410    If Z <> 0 Then 2430
  177. 2420    Let M = M + .00000484814
  178. 2430    Let N = 2
  179. 2440    If M > C Then 2510
  180. 2450    Let N = 1
  181. 2460    If M > A Then 2510
  182. 2470    Let N = 0
  183. 2480  Rem
  184. 2490  Rem - SOLAR RIGHT ASCENSION
  185. 2500  Rem
  186. 2510    Let P = Sin(M) / Cos(M)
  187. 2520    Let P = Atn(.91746 * P)
  188. 2530  Rem
  189. 2540  Rem - QUADRANT ADJUSTMENT
  190. 2550  Rem
  191. 2560    If N = 0 Then 2640
  192. 2570    If N = 2 Then 2600
  193. 2580    Let P = P + B
  194. 2590    GoTo 2640
  195. 2600    Let P = P + D
  196. 2610  Rem
  197. 2620  Rem - SOLAR DECLINATION
  198. 2630  Rem
  199. 2640    Let Q = .39782 * Sin(M)
  200. 2650    Let Q = Q / Sqr(-Q * Q + 1)
  201. 2660    Let Q = Atn(Q)
  202. 2670    Return
  203. 2680  Rem
  204. 2690  Rem - COORDINATE CONVERSION
  205. 2700  Rem
  206. 2710    Let S = R - (Sin(Q) * Sin(E))
  207. 2720    Let S = S / (Cos(Q) * Cos(E))
  208. 2730  Rem
  209. 2740  Rem - NULL PHENOMENON
  210. 2750  Rem
  211. 2760    Let Z = Abs(S)
  212. 2770    If Z <= 1 Then 2830
  213. 2780    Let V = 0
  214. 2790    Return
  215.  
  216.  
  217.  
  218. 2800  Rem
  219. 2810  Rem - ADJUSTMENT
  220. 2820  Rem
  221. 2830    Let S = S / Sqr(-S * S + 1)
  222. 2840    Let S = -Atn(S) + A
  223. 2850    If I = 1 Then 2900
  224. 2860    Let S = D - S
  225. 2870  Rem
  226. 2880  Rem - LOCAL APPARENT TIME
  227. 2890  Rem
  228. 2900    Let Z = .0172028 * K
  229. 2910    Let T = S + P - Z - 1.73364
  230. 2920  Rem
  231. 2930  Rem - UNIVERSAL TIME
  232. 2940  Rem
  233. 2950    Let U = T + F
  234. 2960  Rem
  235. 2970  Rem - WALL CLOCK TIME
  236. 2980  Rem
  237. 2990    Let V = U - G
  238. 3000  Rem
  239. 3010  Rem - DECIMAL TO SEXAGESIMAL
  240. 3020  Rem
  241. 3030    Let Z = V
  242. 3040    GoSub 3200
  243. 3050    Let Z = Z * 3.81972
  244. 3060    Let V = Int(Z)
  245. 3070    Let W = (Z - V) * 60
  246. 3080    Let X = Int(W)
  247. 3090    Let Y = W - X
  248. 3100    If Y < .5 Then 3120
  249. 3110    Let X = X + 1
  250. 3120    If X < 60 Then 3150
  251. 3130    Let V = V + 1
  252. 3140    Let X = 0
  253. 3150    Let V = V + X / 100
  254. 3160    Return
  255. 3170  Rem
  256. 3180  Rem - NORMALIZATION
  257. 3190  Rem
  258. 3200    If Z >= 0 Then 3230
  259. 3210    Let Z = Z + D
  260. 3220    GoTo 3200
  261. 3230    If Z < D Then 3260
  262. 3240    Let Z = Z - D
  263. 3250    GoTo 3230
  264. 3260    Return
  265. End Sub
  266.  
  267. Sub InitTimeZoneStuff ()
  268. TZs% = 41
  269. ReDim TZ$(TZs%)
  270.  
  271. TZ$(1) = "Bering Time (BST)  -11:00"
  272. TZ$(2) = "Cook Islands Time (CIT)  -10:30"
  273. TZ$(3) = "Hawaii/Alaska Time (HST)  -10:00"
  274. TZ$(4) = "Marquesas Island Time (MIT)  -9:30"
  275. TZ$(5) = "Yukon Time (YST)  -9:00"
  276. TZ$(6) = "Pitcairn Island Time (PIT)  -8:30"
  277. TZ$(7) = "Pacific Time (PST)  -8:00"
  278. 'TZ$(8) = "Pacific Daylight Time (PDT)  -7:00"
  279. TZ$(8) = "Mountain Time (MST)  -7:00"
  280. 'TZ$(10) = "Mountain Daylight Time (MDT)  -6:00"
  281. TZ$(9) = "Central Time (CST)  -6:00"
  282. 'TZ$(12) = "Central Daylight Time (CDT)  -5:00"
  283. TZ$(10) = "Eastern Time (EST)  -5:00"
  284. 'TZ$(14) = "Eastern Daylight Time (EDT)  -4:00"
  285. TZ$(11) = "Atlantic Time (AST)  -4:00"
  286. 'TZ$(12) = "Atlantic Daylight Time (AST)  -3:00"
  287. TZ$(12) = "Guyana Time (GUY)  -3:45"
  288. TZ$(13) = "Surinam Time (SNM)  -3:30"
  289. TZ$(14) = "Newfoundland Time (NFT)  -3:30"
  290. TZ$(15) = "Zone 3 West (W03)  -3:00"
  291. TZ$(16) = "Zone 2 West (W02)  -2:00"
  292. TZ$(17) = "Zone 1 West (W01)  -1:00"
  293. TZ$(18) = "Greenwich Mean Time (GMT)   +0:00"
  294. TZ$(19) = "Liberia Time (LIB)  +0:44"
  295. TZ$(20) = "West European Time (WUT)  +1:00"
  296. 'TZ$(26) = "W. Europe Daylight Tm (WDT)  +2:00"
  297. TZ$(21) = "East European Time (EUT)  +2:00"
  298. TZ$(22) = "Zone 3 East (E03)  +3:00"
  299. TZ$(23) = "Iran Time (IRA)  +3:30"
  300. TZ$(24) = "Zone 4 East (E04)  +4:00"
  301. TZ$(25) = "Afganistan Time (AFT)  +4:30"
  302. TZ$(26) = "Zone 5 East (E05)  +5:00"
  303. TZ$(27) = "India Time (IND)  +5:30"
  304. TZ$(28) = "Zone 6 East (E06)  +6:00"
  305. TZ$(29) = "Burma Time (BUR)  +6:30"
  306. TZ$(30) = "Zone 7 East (E07)  +7:00"
  307. TZ$(31) = "Malaysia Time (MAT)  +7:30"
  308. TZ$(32) = "Zone 8 East (E08)  +8:00"
  309. TZ$(33) = "West Australia Time (WAT)  +8:00"
  310. TZ$(34) = "Zone 9 East (E09)  +9:00"
  311. TZ$(35) = "Central Australia (CAT)  +9:30"
  312. TZ$(36) = "Zone 10 East (E10)  +10:00"
  313. TZ$(37) = "East Australia Time (EAT)  +10:00"
  314. TZ$(38) = "Zone 11 East (E11)  +11:00"
  315. TZ$(39) = "Eastern Ocean Time (EOT)  +11:30"
  316. TZ$(40) = "Zone 12 East (E12)  +12:00"
  317. TZ$(41) = "USSR Far East Zone (E13)  +13:00"
  318.  
  319. gLongitude = "073.60W"
  320. gLatitude = "40.45N"
  321. gLocation = "New York City, New York"
  322. gTimezone = "EST"
  323. gDSTAuto = "-1"
  324. gDST = "0"
  325.  
  326.  
  327. End Sub
  328.  
  329. Function SexagesimalToDecimal# (Z#)
  330. Dim W#, X#, Y#
  331. 2010  Rem
  332. 2020  Rem - SEXAGESIMAL TO DECIMAL
  333. 2030  Rem
  334. 2040    Let W = 1
  335. 2050    If Z >= 0 Then 2080
  336. 2060    Let W = -1
  337. 2070    Let Z = Abs(Z)
  338. 2080    Let X = Z + .00005
  339. 2090    Let X = Int(Z)
  340. 2100    Let Z = (Z - X) * 100
  341. 2110    Let Y = Int(Z)
  342. 2120    Let Z = (Z - Y) * 100
  343. 2130    Let Z = (X + Y / 60 + Z / 3600) * W
  344. SexagesimalToDecimal# = Z#
  345. End Function
  346.  
  347.